home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / cshift / test2.f < prev    next >
Text File  |  1993-03-23  |  2KB  |  88 lines
  1.       program shift_test
  2.  
  3.       parameter (n=40)
  4.  
  5.       real a(n,n), b(n,n)
  6.  
  7.       call cmf_random (b)
  8.  
  9.       call test (a,b,n, 1, 1)
  10.       call test (a,b,n, 1, -1)
  11.       call test (a,b,n, 1, 49)
  12.       call test (a,b,n, 1, 51)
  13.       call test (a,b,n, 1, -51)
  14.       call test (a,b,n, 1, 13)
  15.  
  16.       call test1 (a,b,n, 1, 1)
  17.       call test1 (a,b,n, 1, -1)
  18.       call test1 (a,b,n, 1, 49)
  19.       call test1 (a,b,n, 1, 51)
  20.       call test1 (a,b,n, 1, -51)
  21.       call test1 (a,b,n, 1, 13)
  22.  
  23.       call test (a,b,n, 2, 1)
  24.       call test (a,b,n, 2, -1)
  25.       call test (a,b,n, 2, 49)
  26.       call test (a,b,n, 2, 51)
  27.       call test (a,b,n, 2, -51)
  28.       call test (a,b,n, 2, 13)
  29.  
  30.       call test1 (a,b,n, 2, 1)
  31.       call test1 (a,b,n, 2, -1)
  32.       call test1 (a,b,n, 2, 49)
  33.       call test1 (a,b,n, 2, 51)
  34.       call test1 (a,b,n, 2, -51)
  35.       call test1 (a,b,n, 2, 13)
  36.  
  37.       end
  38.  
  39.       subroutine test (a, b, n, dim, pos)
  40.       integer n, dim
  41.       real a(n,n), b(n,n)
  42.       logical equal (n,n)
  43.       integer pos
  44.       integer errors
  45.  
  46.       a = b
  47.  
  48.       b = cshift (b, dim, pos)
  49.  
  50.       if (pos .gt. 0) then
  51.          do i = 1, pos
  52.             a = cshift (a, dim, 1)
  53.          end do
  54.       end if
  55.  
  56.       if (pos .lt. 0) then
  57.          do i = 1, -pos
  58.             a = cshift (a, dim, -1)
  59.          end do
  60.       end if
  61.  
  62.       equal = (b .eq. a)
  63.       errors = count (equal)
  64.       errors = n*n - errors
  65.  
  66.       print *, errors, ' Errors for one shift in dim', dim,' with pos = ', pos
  67.       end
  68.  
  69.       subroutine test1 (a, b, n, dim, pos)
  70.       integer n, dim
  71.       real a(n,n), b(n,n)
  72.       logical equal (n,n)
  73.       integer pos
  74.       integer errors
  75.  
  76.       a = b
  77.       do i = 1, n
  78.          a = cshift (a, dim, pos)
  79.       end do
  80.  
  81.       equal = (b .eq. a)
  82.       errors = count (equal)
  83.       errors = n*n - errors
  84.  
  85.       print *, errors, ' Errors for many shift in dim', dim,' with pos = ', pos
  86.       end
  87.  
  88.